options(scipen=10)
pacman::p_load(latex2exp,Matrix,dplyr,tidyr,ggplot2,caTools,plotly)
rm(list=ls(all=TRUE))
load("data/tf4.rdata")par(mfrow=c(1,2), cex=0.8)
hist(B$Buy)
hist(log(B$Rev,10))B %>% ggplot(aes(x=age,y=Rev)) +
geom_boxplot() + scale_y_log10()#用年紀畫圖
group_by(B,age) %>%
summarise(n=n(), Buy=mean(Buy), Rev=mean(Rev)) %>%
ggplot(aes(Buy,Rev,size=n,label=age)) +
geom_point(alpha=0.5,color='gold') +
geom_text(size=4) +
scale_size(range=c(4,20)) + theme_bw() -> p
ggplotly(p)#buy::平均購買機率;Rev:營收貢獻;泡泡大小:族群人數定義、畫出效用函數 由於c()是一個常用的R內建功能,以下我們用x代表成本 m為高點,b中間數值,a為低點到高點的距離(mba成本效益參數) \[\Delta P = f(x|m,b,a) = m \cdot Logis(\frac{10(x - b)}{a})\]
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),cex=0.7)
curve(DP(x,m=0.20,b=30,a=40), 0, 60, lwd=2, ylim=c(0, 0.25), #0-60的值可被畫在圖上,a=10-50之間...
main="F( x | m=0.2, b=30, a=40 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,60,5),col='lightgrey',lty=2)期望報償的算法: #利潤(p來店機率,margin毛利)x要扣成本! \[\hat{R}(x) = \left\{\begin{matrix} \Delta P \cdot M \cdot margin - x & , & P + \Delta P \leq 1\\ (1-P) \cdot M \cdot margin - x & , & else \end{matrix}\right.\]
估計毛利率(margin)
load("../../w14/unit14.final/data/tf0.rdata") #未把資料放進去
#summarise(z0,1-sum(cost)/sum(price)) #看總體
#group_by(z0,age)%%summarise(z0,1-sum(cost)/sum(price)) #看族群
margin = 0.17 # assume margin = 0.17估計預期報償
m=0.2; b=25; a=40; x=30
dp = pmin(1-B$Buy, DP(x,m,b,a)) #1-B$Buy看其增加機率 #dp??
eR = dp*B$Rev*margin - x
hist(eR,main="預期報償分佈",xlab="預期報償",ylab="顧客數")🌻 有多少顧客的預期報償大於零?
table(eR>0) #TRUE預期報償大於零##
## FALSE TRUE
## 21303 7228
🌻 如果我們針對所有顧客做促銷,預期報償將是?
sum(eR) #會虧203881## [1] -203881
🌻 如果我們針對預期報償大於零顧客做促銷,預期報償將是?
sum(eR[eR>0]) #會賺75883## [1] 75883.81
#x為折價卷面額
#eReturn(全部人都給,都是負的)
#eReturn2(x設定面額,value為可以給的人數->思考預期報償效果,預算多少
m=0.2; b=25; a=40; X = seq(10,45,1)
df = sapply(X, function(x) {
dp = pmin(DP(x,m,b,a),1-B$Buy)
eR = dp*B$Rev*margin - x
c(x=x, eReturn=sum(eR), N=sum(eR > 0), eReturn2=sum(eR[eR > 0]))
}) %>% t %>% data.frame %>%
gather('key','value',-x)
df %>% ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw()mm=c(0.20, 0.25, 0.15, 0.25)
bb=c( 25, 30, 15, 30)
aa=c( 40, 40, 30, 60)
X = seq(0,60,2)
do.call(rbind, lapply(1:length(mm), function(i) data.frame(
Inst=paste0('Inst',i), Cost=X,
Gain=DP(X,mm[i],bb[i],aa[i])
))) %>% data.frame %>%
ggplot(aes(x=Cost, y=Gain, col=Inst)) +
geom_line(size=1.5,alpha=0.5) + theme_bw() +
ggtitle("Prob. Function: f(x|m,b,a)")#inst不同的工具,有不同的mbaX = seq(10, 60, 1)
df = do.call(rbind, lapply(1:length(mm), function(i) { #1-mm就會啟動function(i)
sapply(X, function(x) {
dp = pmin(1-B$Buy, DP(x,mm[i],bb[i],aa[i]))
eR = dp*B$Rev*margin - x
c(i=i, x=x, eR.ALL=sum(eR), N=sum(eR>0), eR.SEL=sum(eR[eR > 0]) )
}) %>% t %>% data.frame
}))
#會按照1-4的工具模擬成效出來(有跑出df的資料匡)
df %>%
mutate_at(vars(eR.ALL, eR.SEL), function(y) round(y/1000)) %>%
gather('key','value',-i,-x) %>%
mutate(Instrument = paste0('I',i)) %>%
ggplot(aes(x=x, y=value, col=Instrument)) +
geom_hline(yintercept=0, linetype='dashed', col='blue') +
geom_line(size=1.5,alpha=0.5) +
xlab('工具選項(成本)') + ylab('預期報償(K)') +
ggtitle('行銷工具優化','假設行銷工具的效果是其成本的函數') +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> p
plotly::ggplotly(p)#eR.ALL對所有人做行銷(沒啥意義)
#用eR.SEL看
#i2可以獲得最高的期望報償(面額40,期望報償143k,n=8783人)每一個工具的最佳參數
group_by(df, i) %>% top_n(1,eR.ALL)## # A tibble: 4 x 5
## # Groups: i [4]
## i x eR.ALL N eR.SEL
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 31 -200481. 7511 83441.
## 2 2 37 -179567. 8822 132374.
## 3 3 20 -36157. 11235 102930.
## 4 4 10 -246916. 0 0
#找出四項工具最高的eR.ALL值(以群為單位)
#top_n(1)選擇第一最高的group_by(df, i) %>% top_n(1,eR.SEL)## # A tibble: 4 x 5
## # Groups: i [4]
## i x eR.ALL N eR.SEL
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 34 -217614. 7569 93549.
## 2 2 40 -196943. 8783 143043.
## 3 3 22 -50497. 10880 107149.
## 4 4 43 -307871. 6979 106687.
#找出四項工具最高的eR.SEL值(以群為單位)
#top_n(1)選擇第一最高的par(cex=0.7, mar=c(2,2,1,2))
table(B$age) %>% barplot
#用在不同人身上,可能m,b,a不太一樣 #年紀越小,有可能b會往右;當年紀越大,b可能在左或是中間值 🗿 討論問題:
如果上述4組工具參數分別是某折價券對4個不同年齡族群的效果:
■ I1 : a24, a29
24,29歲族群使用34的折價卷面額,期望報酬為93549.32 ■ I2 : a34, a39
34,39歲族群40的折價卷面額,期望報酬為143042.80 ■ I3 : a44, a49
44,49歲族群22的折價卷面額,期望報酬為107148.65 ■ I4 : a54, a59, a64, a69
54,59,64,69歲族群43的折價卷面額,期望報酬為106686.88 如果你可以在這4個年齡族群之中選擇行銷對象,你應該如何:
■ 選擇行銷對象(N)?
依照預期報償最大來作為選擇依據,來設定折價面額及年齡對象,因此對象為選擇a34, a39的中年人 ■ 設定折價券的面額(x)?
40的折價卷面額 ■ 估計預期報償(eR.SEL)?
期望報酬為143042.80 選擇a34, a39的中年人,因為可以獲得最高的期望報償。可以採取是網路推播折價卷的行銷手法,因為這個年紀的人通常有一定的收入,且對於網路也有一定的使用習慣。